home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
yerk
/
mps231ss.hqx
/
Mops source
/
Module source
/
PopupMenuMod.txt
< prev
next >
Wrap
Text File
|
1993-02-06
|
3KB
|
109 lines
\ Class PopupMenu. This version handles pop-up menus in dialogs. If we
\ ever need one somewhere else, we'll have to define a subclass with
\ different HIT: and NORMAL: methods.
objPtr THEDLG class_is dialog+
:class POPUPMENU super{ menu }
string+ ITEMTEXT \ Current text displayed in pop-up box
int ITEM# \ Current item # displayed in pop-up box
int BOX# \ Dialog item# of pop-up box
int TITLE# \ Dialog item# of pop-up title
rect TITLERECT
rect POPUPBOX
dicAddr ^DLG \ Points to owning dialog
ptr F-LINK \ Forward link for chain of pop-up menus
\ belonging to the one dialog
:m GETTEXT: ( -- addr len ) get: itemText ;m
:m ITEM#: ( -- item# ) get: item# ;m
:m PUTITEM#: ( item# -- ) put: item# ;m
:m PUTTITLE#: ( title# -- ) put: title# ;m
:m PUT^DLG: ( ^dlg -- ) put: ^dlg ;m
:m F-LINK: get: F-link ;m
:m SET-F-LINK: put: F-link ;m
:m BOX#: get: box# ;m
private
:m CHKDLG: \ ( -- b )
get: ^dlg this_dlg = ;m
:m DT:
chkDlg: self 0EXIT
get: itemtext addr: popUpBox 1 makeint call textBox ;m
public
:m INIT: \ ( cfa-list resid box# title# -- )
put: title# put: box# init: super ;m
:m GETNEW:
new: itemText getNew: super
get: Mhndl -1 makeint call InsertMenu ;m
:m NORMAL:
savePort dlgPort
invert: titleRect
restPort ;m
:m DRAWTEXT:
chkDlg: self 0EXIT
savePort dlgPort dt: self
restPort ;m
:m PUTTEXT: \ ( addr len -- ) Doesn't draw the text, since THIS_DLG
\ may not be valid.
put: itemText ;m
:m DRAWBOX: \ Called from DRAWBOX, which is called from PUboxProc.
chkDlg: self 0EXIT
get: box# itemHandle: this_dlg drop
tempRect ->: popUpBox
dropShadow: popUpBox
getBotX: popUpBox 19 -
getTopY: popUpBox 6 + moveto del
1 1 inset: popUpBox getBotX: popUpBox 20 - putBotX: popUpBox
\ So box outline and down arrow aren't wiped
dt: self ;m
:m HIT:
get: title# itemHandle: this_dlg drop
tempRect ->: titleRect
savePort dlgPort
invert: titleRect
get: theItem itemHandle: this_dlg drop \ Set TempRect to pop-up box
0
get: Mhndl
topint: tempRect l->g unpack swap pack
get: item# 1+ makeint
call PopUpMenuSelect
unpack drop 1- \ our item# - one less than Toolbox's
dup 0>=
IF dup getitem: super putText: self dt: self
restPort
dup exec: super \ Execute action handler
\ Note: the old item# is still in the item# field, but the
\ new one is on the stack. This should be useful when we
\ need to know if the item# is being changed.
put: item#
ELSE
drop restPort
THEN
normal: self ;m
:m LINK: \ ( ^dlg -- )
-> theDlg
theDlg put^dlg: self
['] PUboxProc get: box# setUserProc: theDlg
PUM-link: theDlg put: F-link
^base set-PUM-link: theDlg ;m
;class